(define (insert-word word histogram)
  (let loop ((h histogram))
    (if (null? h)
	(cons (cons word 1) histogram)
	(let ((entry (car h)))
	  (if (equal? word (car entry))
	      (begin (set-cdr! entry (+ 1 (cdr entry)))
		     histogram)
	      (loop (cdr h)))))))

(define (count-words p)
  (let loop ((word '()))
    (let ((char (read-char p)))
      (cond ((eof-object? char) '())
	    ((whitespace? char)
	     (if (null? word)
		 (loop '())
		 (insert-word (list->string (reverse word)) (loop '()))))
	    (else (loop (cons char word)))))))
